#|_____________________________________________________________________
 |
 | plots000.lsp
 | Main entry point for the ViSta Plots, Views and Corkboards System
 | Copyright 2001-2002 by Forrest W. Young
 |
 | The PLOTS, and VIEWS system consists of:
 |
 | 1 - New PLOT OBJECTS and PLOTS menu
 |
 |     The new PLOT objects work from the menubar and have a consistent
 |     syntax which works from the listener. The previous plot objects
 |     still work from the menubar, and never worked from the listener.
 |     
 |     The PLOTS menu provides user access to the new PLOT objects
 |
 |     Files plots00x.lsp contains the code that implements PLOT objects.
 |     The PLOTS menu code is in vismenu1.lsp
 |.
 |     This code is working very smoothly. It does not interfeer
 |     with the operation of the classic spreadplots. The menu items
 |     respond to the current data's datatype.
 | 
 | 2 - New VIEW OBJECTS and VIEWS menu
 |
 |     The new VIEWS (spreadplot) objects use the new PLOT objects.
 |     The new views do not interfere with previously created 
 |     spreadplots which continue to used the old graphics objects.
 |
 |     File views001.lsp contains the code that implements the
 |     current VIEWS objects.
 | 
 |     Currently, VIEWS objects are no different than spreadplot  
 |     objects, other than that they use the new PLOT objects.
 |     They should work with the old code too, but there is no
 |     reason to do this.
 | 
 |     The VIEWS object code should be modified to be based on the 
 |     function names and capabilities in our GOSSIP paper. There 
 |     can be a simple many-to-one mapping of old spreadplot functions 
 |     onto the new GOSSIP function.
 |
 |     The VIEWS menu provides user access to the views, both new and old
 |
 |     The VIEWS menu code is in vismenu1.lsp
 |
 |     Some of the items of the VIEWS menu are never enabled. This is because
 |     the code for these parts does not currently work. I believe that the
 |     reason it doesn't work right is that it uses old function names for
 |     the plot objects. Since the names of the plot objects are now stable
 |     the remaining VIEWS Objects and Menu items should be worked on next.
 |
 | 3 - ViSta ETCH-A-SKETCH OBJECT:   
 |     The ETCH-A-SKETCH object is a GUI for creating new spreadplots
 |     The code in file sketch01.lsp loads this part of the code.
 |
 |     This code does not work, other than putting up a Etch-a-Sketch window.
 |     The code is only a skeleton of the concept. Much work needs to be done.
 |
 | The PLOTS include the following new constructor functions
 |
 | PLOTS001.LSP - Constructor functions to show observation cloud
 |   dot-plot           1 dimensional point plot
 |   scatter-plot       2 dimensional point plot
 |   line-plot          2 dimensional connected point plot
 |   all-scatter-plot   scatterplot matrix 
 |   spinning-plot      3 dimensional spinnable point plot
 |   orbiting-plot      h dimensional spinnable point plot (tourplot)
 |
 | PLOTS002.LSP - Constructor functions to show distribution shape
 |   histogram-plot     linkable, non-dynamic histogram using Tierney's algorithm
 |   distribution-plot  dynamic, non-linkable histogram, frequency polygon and hollowgram
 |   cumulative-plot    quantile-plot and normal-probability-plot
 |   comparison-plot    quantile-quantile plot
 |_______________________________________________________________________
 |#
 
#|

About Using the new VISTA PLOT objects

Each plot is generated by a function called the plot constructor function. The various plot constructor functions have an optional DATA argument and several KEYWORD arguments. If no arguments are used, a default plot is constructed from information in $, the current data. The information that is used is the first few variables in the list of all variables of the appropriate variable types. The number of vectors that are used depends on the details of the plot, as does the defintion of the appropriate variable types. The plot is shown in its' own window (i.e., not inside a container window), although the menu system may override this default.
 
All plots share the following arguments and syntax:

    (PLOT-CONSTRUCTOR-NAME &optional DATA &key KEYWORD-ARGUMENTS)

The optional DATA argument may be omitted or may be NIL, or it may be a data object, a list of numeric or string elements, a list of variable objects, a list of equal-length lists, a vector, a list of equal-length vectors, or a matrix. If omitted or NIL, DATA is assumed to be $, the current dataobject. In all cases, DATA is converted into a list of equal-length vectors. one vector for each of the OK-VAR-TYPES (see below) variables in the referenced data object.

The plot is constructed from the first few vectors in the list of vectors, the number of vectors depending on the details of the plot. If you need to use any of the keyword arguments, the data must be specified, and it must be mentioned before the keywords.

The keyword arguments consist of STANDARD keyword arguments (which are used by all of the plots and which are discussed here) and UNIQUE keyword arguments (which are unique to each plot and which are discussed in the help for each plot). If you need to use any of the keyword arguments, the data must be specified (perhaps as nil or $) before the keywords are specified. The standard keyword arguments (with defaults in parentheses, if appropriate) are:

in  (unused)    T, NIL, UNUSED or CONTAINER - sets the container window.
ok-var-types    a list of symbols or strings of usable variable types
variable-labels a list of strings, one for each variable 
point-labels    a list of strings, one per point 
                (not for histogram-plot, mosaic-plot or bar-graph)
linked   (T)    T or NIL for linked with other plots via stat object
                (not for comparison-plot, mosaic-plot or bar-graph)
connect (NIL)   T or NIL for connecting points with lines
                (not for histogram-plot, mosaic-plot or bar-graph)
show     (T)    T or NIL indicating if the plot is shown when created
top-most (T)    T or NIL sets initial always-on-top state
location        a list (x y) locating the plot's upper-left corner 
size size       a list (w h) of the plot's width & height 
title           a string shown as the window title
legend1         a string for the first line of the legend 
legend2         a string for the second line of the legend

VARIABLE-LABELS (or WAY-LABELS) and POINT-LABELS
Variables (or ways, on some graphs) and points can be labeled with the VARIABLE-LABELS (or WAY-LABELS) and POINT-LABELS keywords (some graphs accept :WAY-LABELS as an alias of :VARIABLE-LABELS, and some don't support :POINT-LABELS). Each argument is followed by a list of the appropriate number of strings.

IN
By default, each plot will appear as an independent window (i.e., not inside a container window) when it is created. If :IN is used, the new graphic will appear inside a container window. If a menu item is used to create the graphic, IN will be set by the menuing system to direct the graph to the appropriate container.The container will be:
  1: CONTAINER if IN is CONTAINER
  2: XLISPSTAT if IN is NIL 
  3: *ACTIVE-CONTAINER* if both IN and *ACTIVE-CONTAINER* are T
Note that for case 3 it can be tricky to determine where the graph appeared if the container is not visible.

SHOW, TOP-MOST, LOCATION, SIZE, LINKED
The plot will not be shown when :SHOW is NIL until it is sent the message :SHOW-WINDOW. When the window appears it will be be at LOCATION (which is relative to the window's container, if there is one) and be of size SIZE. The graphic will be :TOP-MOST by default. Note that the graphic will not be seen when it appears if its containing window is closed, minimized, located off-screen, or obscurred by another window.

TITLE, LEGEND1, LEGEND2
Each plot can have a title and two legends.

  _____________________________________________________________________
 |#


  (setf *free-plots* *desktop-container*)
  (setf *plot-menu-hot-spot* t)
  (setf *mosaic-bargraph-max-level*  64)
  (setf *mosaic-bargraph-max-cells* 144)
  (setf *mosaic-bargraph-max-ways*    4)


(defun graph-frame (&rest args) 
  (enable-container *desktop-container*)
  *desktop-container*)



  (defun before-new-plot (data &optional (ok-var-types '(all)))
    "ARGS: DATA &OPTIONAL OK-VAR-TYPES
  Prepares data for input to a graphics module. DATA may be a DATA OBJECT, a VARIABLE OBJECT, a LIST, a VECTOR, a MATRIX or may be NIL. If data is a list the elements may be a mixture of numbers and strings, or may be lists, variable objects or vectors. If DATA is omitted or is NIL it is assumed to be $ (the current data).  OK-VAR-TYPES specifies the type of variables that are used when DATA is NIL or a DATA OBJECT (all variables are used if not specified). 
  Returns a three or four element list. The first element is a list of N lists or vectors of data, one for each variable. The second element is a list of N variable names. The third element is a list of M observation labels. When DATA is a data object there is a fourth element which is the data object identification."
    (flet ((outlist (n str) (mapcar #'(lambda (i) 
                                    (format nil "~a~a" str i)) 
                                (iseq n))))
      (let* ((variable-labels) (point-labels) (title) (result))
        (send *watcher* :write-text "Preparing Data for Plot")
        (unless data (setf data $))
        (setf result
              (cond
                ((variablep data)                         ;VARIABLE OBJECT
                 (list (list data)
                       (list "Var1")
                       (outlist (length data) "Obs")))
                ((objectp data)                           ;DATA OBJECT -ok
                 (list 
                  (send data :active-data-vectors ok-var-types)
                  (send data :active-variables ok-var-types)
                  (send data :active-labels)
                  data))
                ((matrixp data)                           ;MATRIX -ok
                 (list (column-list data) 
                       (outlist (array-dimension data 1) "Column")
                       (outlist (array-dimension data 0) "Row")))
                ((and (vectorp data)                      ;VECTOR -ok
                      (not (stringp data)))
                 (list (list data) 
                       (list "Var1") 
                       (outlist (length data) "Obs")))
                ((listp data)
                 (cond
                   ((or (numberp (first data))            ;LIST OF NUMBERS OR STRINGS -ok
                        (stringp (first data)))
                    (list (list data) 
                          (list "Var1") 
                          (outlist (length data) "Obs")))
                   ((not (= 1 (length (remove-duplicates (map-elements #'length data)))))
                    (message "Data are a list of sublists, vectors or variable objects. The sublists, vectors or variable objects must all be the same length")
                    nil)
                   ((listp (first data))                  ;LIST OF EQUAL-LENGTH LISTS -ok
                    (list data
                          (outlist (length data) "Var")
                          (outlist (length (first data)) "Obs")))
                   ((variablep (first data))              ;LIST OF VARIABLE OBJECTS
                    (list data 
                          (outlist (length data) "Var") 
                          (outlist (length (first data)) "Obs")))
                   ((vectorp (first data))                ;LIST OF VECTORS -ok
                    (list data 
                          (outlist (length data) "Var") 
                          (outlist (length (first data)) "Obs")))
                   (t nil)))
                 (t nil)))
        (unless result
                (help (format nil "The data are not appropriate for plotting.~2%They must be either a DATA OBJECT, a VARIABLE OBJECT, a LIST, a VECTOR, or a MATRIX.~2%If the data are a list, the elements of the list may be a mixture of numbers and strings, or they may be  lists, vectors or variable objects. The elements of a list must all be the same length.~2%If the data are omitted or are NIL it is assumed that they are the current data.")))
        result)))
  
  (defmeth graph-proto :after-new-plot 
   (pop-out top-most show size actcon linkable dob)
    (send *watcher* :write-text (format nil "Creating ~a" (send self :title)))
    (setf pop-out (if (equal pop-out t) t nil)) 
    (unless (send actcon :n-graphs) (send actcon :n-graphs 0))
    (send actcon :n-graphs (1+ (send actcon :n-graphs)))
    (let* ((graf self)
           (menu (send self :menu))
           (floc (* (- (send actcon :n-graphs) 1) '(20 20)))
           (overlay (length (send self :overlays)))
           )
      (ignore-errors 
       (when overlay
             (dotimes (i overlay)
                      (send (select (send self :overlays) i) :remove-button ':pop)
                      (send (select (send self :overlays) i) :remove-button ':zoom))))
      (when (> (+ (first floc) (first size)) (first *effective-screen-size*))
            (send actcon :n-graphs 0)
            (setf (select floc 0) 0))
      (when (> (+ (second floc) (second size)) (second *effective-screen-size*))
            (setf (select floc 1) 
                  (+ (- (second floc) (second *effective-screen-size*)) (second size))))
      (apply #'send self :frame-location floc)
      (send self :pop-out-on pop-out)
      (send self :top-most-on top-most)
      (send self :container actcon)
      (send self :data-object dob)
      (send dob :plots (append (send dob :plots) (list self)))
      (when show (apply #'send self :location (+ (send self :location) 2000)))
      (when pop-out 
            (send self :pop-out t)
            (apply #'send self :size size))
      (when menu 
            (send menu :remove)
            (when show (send self :redraw))
            )
      (when show 
            (apply #'send self :location (- (send self :location) 2000))
            (send self :show-window))
      (send (send self :menu) :append-items (send dash-item-proto :new))
      (send self :append-always-on-top-menu-item top-most)
      (send self :append-maximize-restore-menu-item)
      (when linkable (send self :setup-linkage ))
      (defmeth self :close ()
        (let ((dob (send self :data-object)))
          (send dob :plots (remove self (send dob :plots)))
          (when linkable
                (send dob :linked-plots (remove self (send dob :linked-plots))))
          (call-next-method)))
      (setf *current-plot* self)
      (setf *cp* self)
      (setf *graph* self)
      (send *watcher* :close)
      self))

(defmeth graph-proto :setup-linkage ( )
  (defmeth self :links ()
    (let* ((dob (send self :data-object))
           (plot-list (send dob :links))) ;(send dob :linked-plots)
      (if (member self plot-list) plot-list)))
  
  (defmeth self :linked (&optional (link nil set))
    (when set
          (let* ((dob (send self :data-object))
                 (plot-list (send dob :linked-plots)))
            (send dob :linked-plots
                  (if link
                      (cons self plot-list)
                      (remove self plot-list)))
            (call-next-method link)))
    (call-next-method))
  (send self :linked t)
  (send *obs-window* :linked t)
  )

(defmeth graph-proto :pop-out-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be popped out."
  (unless (send self :has-slot 'pop-out-on)
          (send self :add-slot 'pop-out-on))
  (if set (setf (slot-value 'pop-out-on) logical))
  (slot-value 'pop-out-on)) 

(defmeth graph-proto :top-most-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be made to be top most."
  (unless (send self :has-slot 'top-most-on)
          (send self :add-slot 'top-most-on))
  (if set (setf (slot-value 'top-most-on) logical))
  (slot-value 'top-most-on)) 

(defmeth graph-proto :container (&optional (objid nil set))
"Message args: (&optional logical)
 Sets or retrieves object id of a graph's container, if there is one."
  (unless (send self :has-slot 'container)
          (send self :add-slot 'container))
  (if set (setf (slot-value 'container) objid))
  (slot-value 'container))


; following is in toolmenu.lsp
; adds :set-plot-and-view-menu-item-states to menu item updating


#|
(defmeth mv-data-object-proto :set-menu-item-states 	 
              (menu-length current-item-number current-icon ds-obj ds-open)
"Sets menu states, analysis states, transformation states, menu item states, and toolbar button states using generalized-data-type"
  (initialize-desktop-window-menu t)
  (send self :set-menu&tool-states (send self :generalized-data-type))
  (send create-dob-data-menu-item :enabled t)
  (send delete-data-menu-item :enabled t)
  (send delete-model-menu-item :enabled nil)
  (send impute-missing-data-menu-item :enabled nil)
  (send summarize-data-menu-item :enabled t)
  (send report-data-menu-item :enabled t)
  (send new-data-file-menu-item :enabled t)
  
  (when *plots-menu* (send *plots-menu* :set-vista-menu-item-states self))
  (when *views-menu* (send *views-menu* :set-vista-menu-item-states self))
  (cond
    ((send *vista* :missing-values) 
     (send corr-trans-menu-item :enabled nil)
     (send covar-trans-menu-item :enabled nil)
     (send dist-trans-menu-item  :enabled nil)
     (send orth-trans-menu-item  :enabled nil))
    (t (send *vista* :set-transformation-states (send self :data-type))))
  (when (send *vista* :long-menus)
        (send (select (send *data-menu* :items) current-item-number) :mark t))
  (cond 
    ((send *vista* :missing-values)
     (send visualize-data-menu-item :enabled t);was nil PV
     (send summarize-data-menu-item :enabled t);was nil PV
     (send report-data-menu-item :enabled t);was nil PV
     (send impute-missing-data-menu-item :enabled t))
    ((send current-data :matrices)
     (send merge-vars-menu-item :enabled nil)
     (send merge-obs-menu-item :enabled nil)
     (send visualize-data-menu-item :enabled nil)
     (when previous-data (send merge-mats-menu-item :enabled t))
     (send *vista* :show-mats))
    (t
     (when previous-data 
           (send merge-vars-menu-item :enabled t)
           (send merge-obs-menu-item :enabled t))
     (send *vista*   :show-obs)
     (send merge-mats-menu-item    :enabled nil)
     (send visualize-data-menu-item :enabled t)))
  (if (member "category" 
                (map-elements #'string-downcase  
                              (send self :active-types '(all))) 
                :test #'equal)
      (send freq-tables-data-menu-item :enabled t)
      (send freq-tables-data-menu-item :enabled nil))
  )

 FOLLOWING THREE METHODS ARE IN SYSTMOB1.LSP

(defmeth *obs-window* :linked (&optional (link-state nil set))
      "Message args: (&optional link-state)
Sets or retrieves whether linking is on for the observation list window."
      (unless (send self :has-slot 'linked)
              (send self :add-slot 'linked))
      (if set (setf (slot-value 'linked) link-state))
      (slot-value 'linked))
    
(defmeth *obs-window* :links ()
  (cond
    ((or (not $) (not (equal $ @))) nil)
    ((send self :linked) (send (send self :data-object) :links))
    (t nil)))
    
(defmeth *obs-window* :data-object ()
  (if (equal @ $) $ nil))

|#
  

(defun linked-plots (&optional (data-object  $))
"Message arguments: (&optional (data-object  $))
Returns list of all plots linked via DATA-OBJECT. List includes *obs-window* if DATA-OBJECT is the current object. Returns NIL if DATA-OBJECT's linkage is not activated. Returns (NIL) if linkage is activated but there are no linked plots."
  (if data-object (send data-object :links) nil))

(defmeth mv-data-object-proto :linked-plots (&optional (obj-list nil set))
"Message args: (&optional logical)
 Sets or retrieves the list of plots linked to this data object."
  (unless (send self :has-slot 'linked-plots)
          (send self :add-slot 'linked-plots))
  (if set (setf (slot-value 'linked-plots) obj-list))
  (slot-value 'linked-plots))

(defmeth mv-data-object-proto :linked (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether this data object is linked with plots)."
  (unless (send self :has-slot 'linked)
          (send self :add-slot 'linked t))
  (if set (setf (slot-value 'linked) logical))
  (slot-value 'linked))

(defmeth mv-data-object-proto :links ()
"Message arguments: None
Returns the list of plots linked to this data object. List includes *obs-window* if this data object is the current object. Returns NIL if linkage is not activated. Returns (NIL) if linkage is activated but there are no linked plots. "
  (cond
    ((not (send self :linked)) nil)
    ((equal self @) (remove nil (combine *obs-window* (send self :linked-plots))))
    ((and (send self :linked) (not (send self :linked-plots))) (list nil))
    (t (remove nil (send self :linked-plots)))))

(defmeth mv-data-object-proto :plots (&optional (list nil set))
"Message args: (&optional list)
 Sets or retrieves the list of plots for this data object"
  (unless (send self :has-slot 'plots)
          (send self :add-slot 'plots))
  (if set (setf (slot-value 'plots) list))
  (slot-value 'plots)) 

;following appear in after-new-plot method

#|
(defmeth graph-proto :links ()
  (let* ((dob (send self :data-object))
         (plot-list (if dob (send dob :linked-plots) nil)))
    (if plot-list (if (member self plot-list) plot-list nil) nil)))

(defmeth *graph* :linked (&optional (link nil set))
  (when set
        (let* ((dob (send self :data-object))
               (plot-list (if dob (send dob :linked-plots) nil)))
          (if dob
              (send dob :linked-plots
                    (if link
                        (cons self plot-list)
                        (remove self plot-list)))))))
          (call-next-method link)))
  (call-next-method))
|#



(defun show-all-plots (&optional (data-object  $))
  (send data-object :show-plots))

(defun show-linked-plots (&optional (data-object  $))
  (send data-object :show-plots t))

(defmeth graph-proto :show-plots (&optional linked)
  (send (send self :data-object) :show-plots linked))

(defmeth graph-proto :show-linked-plots ()
  (send (send self :data-object) :show-plots t))

(defmeth mv-data-object-proto :show-plots (&optional linked)
"Message arguments: none
Shows all plots linked with this data object (excluding *obs-window*)"
  (mapcar #'(lambda (plot) 
              (send plot :show-window)
              (send plot :top-most t))
          (if linked 
              (send self :linked-plots)
              (send self :plots))))

(defun hide-all-plots (&optional (data-object  $))
  (send data-object :hide-plots))

(defun hide-linked-plots (&optional (data-object  $))
  (send data-object :hide-plots t))

(defmeth graph-proto :hide-plots (&optional linked)
  (send (send self :data-object) :hide-plots linked))

(defmeth mv-data-object-proto :hide-plots (&optional linked)
"Message arguments: none
Hides all plots linked with this data object (excluding *obs-window*)"
  (mapcar #'(lambda (plot) 
              (send plot :hide-window))
          (if linked 
              (send self :linked-plots)
              (send self :plots))))

(defun close-all-plots (&optional (data-object  $))
  (send data-object :close-plots))

(defun close-linked-plots (&optional (data-object  $))
  (send data-object :close-plots t))

(defmeth mv-data-object-proto :close-plots (&optional linked)
"Message arguments: none
Closes all plots linked with this data object (excluding *obs-window*)"
  (mapcar #'(lambda (plot) 
              (send plot :close))
          (if linked 
              (send self :linked-plots)
              (send self :plots))))



(defmeth menu-item-proto :plots (&optional (list nil set))
"Message args: (&optional list)
 Sets or retrieves the list of plots for this data object"
  (unless (send self :has-slot 'plots)
          (send self :add-slot 'plots))
  (if set (setf (slot-value 'plots) list))
  (slot-value 'plots)) 